indiv smooths
Megan Lott
10/14/2020
Load all required libraries.
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.1.1 v dplyr 1.0.6
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1## Warning: package 'ggplot2' was built under R version 3.6.3## Warning: package 'tibble' was built under R version 3.6.3## Warning: package 'tidyr' was built under R version 3.6.3## Warning: package 'readr' was built under R version 3.6.3## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 3.6.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)## Warning: package 'broom' was built under R version 3.6.3Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 324)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 12.99671 12.99471 12.99278 12.99091 12.98908 12.98730 12.98555 12.98384
## [9] 12.98216 12.98050 12.97885 12.97722 12.97558 12.97395 12.97231 12.97066
## [17] 12.96899 12.96730 12.96557 12.96381 12.96201 12.96017 12.95827 12.95631
## [25] 12.95429 12.95220 12.95003 12.94779 12.94545 12.94304 12.94056 12.93803
## [33] 12.93544 12.93280 12.93013 12.92742 12.92468 12.92192 12.91915 12.91637
## [41] 12.91359 12.91081 12.90804 12.90529 12.90256 12.89985 12.89719 12.89456
## [49] 12.89199 12.88946 12.88700 12.88461 12.88228 12.88004 12.87788 12.87581
## [57] 12.87385 12.87187 12.86980 12.86763 12.86537 12.86304 12.86064 12.85818
## [65] 12.85567 12.85312 12.85053 12.84792 12.84530 12.84266 12.84003 12.83740
## [73] 12.83479 12.83221 12.82967 12.82717 12.82472 12.82233 12.82002 12.81778
## [81] 12.81563 12.81357 12.81162 12.80978 12.80807 12.80648 12.80503 12.80373
## [89] 12.80259 12.80161 12.80081 12.80019 12.79927 12.79761 12.79528 12.79233
## [97] 12.78883 12.78484 12.78042 12.77564 12.77055 12.76522 12.75971 12.75409
## [105] 12.74841 12.74274 12.73714 12.73167 12.72640 12.72138 12.71668 12.71236
## [113] 12.70848 12.70511 12.70231 12.70013 12.69865 12.69792 12.69800 12.69897
## [121] 12.70081 12.70345 12.70683 12.71088 12.71554 12.72077 12.72649 12.73264
## [129] 12.73918 12.74603 12.75313 12.76043 12.76787 12.77539 12.78292 12.79041
## [137] 12.79780 12.80502 12.81202 12.81874 12.82512 12.83109 12.83874 12.84983
## [145] 12.86381 12.88013 12.89824 12.91759 12.93764 12.95784 12.97763 12.99647
## [153] 13.01382 13.02912 13.04182 13.05138 13.06026 13.07112 13.08371 13.09777
## [161] 13.11305 13.12931 13.14629 13.16374 13.18141 13.19904 13.21639 13.23320
## [169] 13.24922 13.26420 13.27789 13.29004 13.30039 13.30870 13.31470 13.32014
## [177] 13.32680 13.33453 13.34315 13.35250 13.36243 13.37277 13.38335 13.39402
## [185] 13.40460 13.41495 13.42488 13.43425 13.44289 13.45064 13.45732 13.46279
## [193] 13.46688 13.46942 13.47024 13.46920 13.46613 13.46085 13.45343 13.44413
## [201] 13.43309 13.42045 13.40638 13.39100 13.37448 13.35696 13.33859 13.31952
## [209] 13.29988 13.27984 13.25953 13.23911 13.21872 13.19851 13.17863 13.15922
## [217] 13.14044 13.11929 13.09318 13.06290 13.02921 12.99290 12.95472 12.91547
## [225] 12.87590 12.83680 12.79893 12.76308 12.73000 12.70049 12.67531 12.65042
## [233] 12.62168 12.58966 12.55494 12.51811 12.47974 12.44043 12.40074 12.36127
## [241] 12.32260 12.28530 12.24995 12.21715 12.18747 12.16150 12.13980 12.12196
## [249] 12.10688 12.09418 12.08346 12.07434 12.06643 12.05933 12.05267 12.04604
## [257] 12.03907 12.03135 12.02251 12.01216 11.99990 11.98705 11.97514 11.96410
## [265] 11.95384 11.94429 11.93538 11.92701 11.91912 11.91162 11.90444 11.89750
## [273] 11.89072 11.88403 11.87734 11.87058 11.86367 11.85654 11.84910 11.84127
## [281] 11.83344 11.82601 11.81897 11.81228 11.80591 11.79985 11.79405 11.78851
## [289] 11.78318 11.77804 11.77307 11.76824 11.76351 11.75888 11.75440 11.75018
## [297] 11.74622 11.74250 11.73902 11.73578 11.73277 11.72998 11.72742 11.72507
## [305] 11.72293 11.72099 11.71926 11.71772 11.71638 11.71521 11.71412 11.71299
## [313] 11.71186 11.71076 11.70972 11.70877 11.70795 11.70727 11.70678 11.70651
## [321] 11.70648 11.70672 11.70727 11.70815#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 324)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.61301 12.60907 12.60523 12.60150 12.59787 12.59434 12.59090 12.58756
## [9] 12.58430 12.58113 12.57803 12.57501 12.57206 12.56918 12.56637 12.56361
## [17] 12.56091 12.55826 12.55565 12.55310 12.55058 12.54809 12.54564 12.54322
## [25] 12.54083 12.53845 12.53609 12.53374 12.53140 12.52907 12.52673 12.52440
## [33] 12.52209 12.51979 12.51750 12.51525 12.51302 12.51082 12.50867 12.50655
## [41] 12.50449 12.50247 12.50051 12.49861 12.49678 12.49501 12.49332 12.49171
## [49] 12.49019 12.48875 12.48740 12.48615 12.48500 12.48396 12.48302 12.48221
## [57] 12.48151 12.48093 12.48049 12.48018 12.48000 12.47997 12.48008 12.48035
## [65] 12.48072 12.48115 12.48164 12.48219 12.48281 12.48350 12.48426 12.48509
## [73] 12.48600 12.48700 12.48807 12.48923 12.49048 12.49181 12.49325 12.49477
## [81] 12.49640 12.49813 12.49996 12.50190 12.50395 12.50611 12.50839 12.51078
## [89] 12.51330 12.51594 12.51870 12.52160 12.52462 12.52778 12.53108 12.53452
## [97] 12.53809 12.54182 12.54569 12.54951 12.55310 12.55647 12.55965 12.56267
## [105] 12.56555 12.56830 12.57096 12.57355 12.57608 12.57858 12.58108 12.58360
## [113] 12.58616 12.58879 12.59150 12.59432 12.59727 12.60039 12.60368 12.60717
## [121] 12.61089 12.61486 12.61910 12.62363 12.62848 12.63368 12.63953 12.64629
## [129] 12.65383 12.66206 12.67086 12.68012 12.68974 12.69960 12.70961 12.71964
## [137] 12.72960 12.73937 12.74884 12.75791 12.76647 12.77441 12.78401 12.79726
## [145] 12.81357 12.83235 12.85302 12.87500 12.89769 12.92051 12.94287 12.96420
## [153] 12.98390 13.00139 13.01609 13.02740 13.03851 13.05273 13.06965 13.08891
## [161] 13.11009 13.13282 13.15670 13.18133 13.20634 13.23132 13.25590 13.27967
## [169] 13.30224 13.32323 13.34224 13.35889 13.37278 13.38352 13.39073 13.39610
## [177] 13.40158 13.40709 13.41256 13.41791 13.42307 13.42797 13.43254 13.43670
## [185] 13.44039 13.44352 13.44602 13.44783 13.44887 13.44907 13.44835 13.44665
## [193] 13.44389 13.43999 13.43489 13.42850 13.42077 13.41162 13.39994 13.38492
## [201] 13.36689 13.34618 13.32311 13.29803 13.27126 13.24314 13.21400 13.18417
## [209] 13.15398 13.12377 13.09386 13.06460 13.03630 13.00931 12.98396 12.96057
## [217] 12.93948 12.91683 12.88908 12.85709 12.82169 12.78372 12.74403 12.70346
## [225] 12.66284 12.62303 12.58487 12.54918 12.51683 12.48864 12.46547 12.44383
## [233] 12.41995 12.39420 12.36696 12.33860 12.30950 12.28003 12.25058 12.22151
## [241] 12.19320 12.16604 12.14039 12.11663 12.09514 12.07629 12.06046 12.04800
## [249] 12.03872 12.03216 12.02786 12.02536 12.02421 12.02394 12.02411 12.02425
## [257] 12.02391 12.02263 12.01995 12.01541 12.00856 12.00082 11.99389 11.98772
## [265] 11.98225 11.97743 11.97320 11.96952 11.96632 11.96355 11.96117 11.95911
## [273] 11.95732 11.95575 11.95435 11.95306 11.95182 11.95059 11.94931 11.94793
## [281] 11.94675 11.94610 11.94594 11.94625 11.94698 11.94811 11.94960 11.95142
## [289] 11.95353 11.95590 11.95849 11.96128 11.96422 11.96730 11.97061 11.97428
## [297] 11.97832 11.98270 11.98742 11.99246 11.99781 12.00346 12.00941 12.01563
## [305] 12.02212 12.02886 12.03585 12.04308 12.05052 12.05818 12.06592 12.07366
## [313] 12.08142 12.08924 12.09717 12.10523 12.11347 12.12191 12.13060 12.13958
## [321] 12.14887 12.15852 12.16856 12.17902#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 324)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 11.98661 11.98340 11.98030 11.97730 11.97439 11.97156 11.96882 11.96614
## [9] 11.96353 11.96097 11.95847 11.95600 11.95358 11.95118 11.94881 11.94646
## [17] 11.94411 11.94177 11.93942 11.93707 11.93469 11.93229 11.92986 11.92739
## [25] 11.92488 11.92231 11.91968 11.91699 11.91423 11.91139 11.90846 11.90544
## [33] 11.90232 11.89909 11.89575 11.89229 11.88871 11.88504 11.88129 11.87746
## [41] 11.87358 11.86964 11.86567 11.86167 11.85766 11.85364 11.84963 11.84564
## [49] 11.84168 11.83776 11.83389 11.83009 11.82636 11.82272 11.81918 11.81575
## [57] 11.81244 11.80926 11.80623 11.80335 11.80064 11.79810 11.79576 11.79361
## [65] 11.79138 11.78878 11.78583 11.78257 11.77903 11.77522 11.77119 11.76696
## [73] 11.76256 11.75801 11.75335 11.74860 11.74380 11.73896 11.73412 11.72931
## [81] 11.72455 11.71988 11.71531 11.71089 11.70663 11.70258 11.69874 11.69516
## [89] 11.69186 11.68887 11.68622 11.68394 11.68205 11.68058 11.67957 11.67903
## [97] 11.67901 11.67952 11.68059 11.68179 11.68267 11.68329 11.68369 11.68392
## [105] 11.68402 11.68404 11.68402 11.68401 11.68405 11.68419 11.68448 11.68496
## [113] 11.68567 11.68667 11.68800 11.68970 11.69181 11.69439 11.69749 11.70113
## [121] 11.70538 11.71028 11.71586 11.72219 11.72930 11.73724 11.74717 11.75999
## [129] 11.77534 11.79286 11.81219 11.83297 11.85484 11.87745 11.90044 11.92344
## [137] 11.94610 11.96805 11.98895 12.00842 12.02612 12.04168 12.05849 12.07972
## [145] 12.10465 12.13258 12.16280 12.19461 12.22730 12.26016 12.29249 12.32358
## [153] 12.35273 12.37923 12.40237 12.42144 12.43978 12.46095 12.48458 12.51030
## [161] 12.53774 12.56654 12.59632 12.62672 12.65738 12.68792 12.71797 12.74718
## [169] 12.77517 12.80157 12.82601 12.84814 12.86758 12.88396 12.89691 12.90837
## [177] 12.92043 12.93295 12.94580 12.95885 12.97198 12.98504 12.99791 13.01046
## [185] 13.02255 13.03407 13.04486 13.05481 13.06378 13.07164 13.07827 13.08352
## [193] 13.08727 13.08939 13.08975 13.08821 13.08465 13.07893 13.07030 13.05830
## [201] 13.04325 13.02545 13.00522 12.98288 12.95874 12.93312 12.90632 12.87867
## [209] 12.85047 12.82203 12.79369 12.76574 12.73850 12.71229 12.68742 12.66420
## [217] 12.64294 12.61926 12.58924 12.55391 12.51432 12.47148 12.42645 12.38026
## [225] 12.33394 12.28852 12.24505 12.20456 12.16809 12.13666 12.11132 12.08813
## [233] 12.06272 12.03543 12.00665 11.97672 11.94602 11.91492 11.88377 11.85293
## [241] 11.82279 11.79369 11.76600 11.74009 11.71631 11.69505 11.67665 11.66157
## [249] 11.64970 11.64056 11.63367 11.62855 11.62472 11.62171 11.61903 11.61621
## [257] 11.61277 11.60823 11.60210 11.59393 11.58321 11.57139 11.56018 11.54953
## [265] 11.53942 11.52980 11.52063 11.51187 11.50349 11.49544 11.48768 11.48018
## [273] 11.47289 11.46578 11.45881 11.45193 11.44510 11.43830 11.43147 11.42458
## [281] 11.41787 11.41159 11.40571 11.40020 11.39503 11.39018 11.38561 11.38130
## [289] 11.37722 11.37335 11.36964 11.36609 11.36265 11.35929 11.35614 11.35329
## [297] 11.35074 11.34847 11.34648 11.34474 11.34325 11.34199 11.34095 11.34011
## [305] 11.33947 11.33900 11.33870 11.33855 11.33854 11.33866 11.33877 11.33877
## [313] 11.33871 11.33863 11.33855 11.33853 11.33859 11.33878 11.33914 11.33971
## [321] 11.34052 11.34161 11.34303 11.34480#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")